Carousel/CAROUSEL.cdr/mactosh/lang/p_image1.sit/LSP Source/FileUnit.p

Text File | 1989-07-29 | 61.2 KB | 2,406 lines

unit FileUnit;

{Routines used by the Image program for implementing File menu commands.}

interface


    uses
        QuickDraw, OSIntf, PickerIntf, PrintTraps, ToolIntf, globals, Utilities, Graphics;


    function CloseAWindow (WhichWindow: WindowPtr): integer;
    procedure OpenFile (fname: str255; vnum: integer);
    function OpenPict (fname: str255; vnum: integer; Reverting: boolean): boolean;
    procedure SaveTiffAs (slines, sPixelsPerLine: integer; SavingSelection: boolean);
    procedure SavePictAs (SavingSelection: boolean);
    procedure SaveSelection (SaveAsSameType: boolean);
    procedure SaveFile;
    procedure GetFile;
    procedure ImportFile;
    procedure SavePalette;
    procedure RevertToSaved;
    procedure SaveSettings;
    procedure GetInfo;
    procedure SaveCameraWindow;
    procedure SaveOutline;

    procedure DoPageSetup;
    procedure Print (ShowDialog: boolean);
    procedure SetHalftone;



implementation

    procedure TypeMismatch (fname: str255);
        var
            ignore: integer;
    begin
        ParamText('The file "', fname, '" is a different type, and therefore cannot be replaced', '');
        InitCursor;
        ignore := Alert(MessageID, nil);
    end;


    procedure SaveCustomClut (fname: str255; vnum: integer);
        var
            RefNum: integer;
            err: OSErr;
            MyColorTable: record
                    ctSeed: LONGINT;
                    transIndex: INTEGER;
                    ctSize: INTEGER;
                    ctTable: MyCSpecArray;
                end;
            TempH: Handle;
            Size: LongInt;
    begin
        err := SetVol(nil, vnum);
        CreateResFile(fname);
        refNum := OpenResFile(fname);
        TempH := GetResource('clut', KlutzID);
        if GetHandleSize(TempH) > 0 then
            RmveResource(TempH);
        size := SizeOF(MyColorTable);
        TempH := NewHandle(size);
        with MyColorTable do begin
                ctSeed := 0;
                TransIndex := 0;
                ctsize := 255;
                ctTable := info^.cTable;
            end;
        BlockMove(@MyColorTable, TempH^, size);
        AddResource(TempH, 'clut', KLutzID, '');
        WriteResource(TempH);
        DisposHandle(TempH);
        CloseResFile(refNum);
    end;


    function IOCheck (err: OSerr): integer;
        var
            ErrStr, Message: str255;
            ignore: integer;
    begin
        if err <> 0 then begin
                Message := '';
                if err = -43 then
                    Message := 'Disk Directory Full';
                if err = -34 then
                    Message := 'Disk Full';
                NumToString(err, ErrStr);
                ParamText(Message, ErrStr, '', '');
                InitCursor;
                ignore := alert(IOErrorID, nil);
            end;
        IOCheck := err;
    end;


    procedure LookForCluts (fname: str255; vnum: integer);
        var
            RefNum: integer;
            err: OSErr;
            ok1, ok2: boolean;
    begin
        if not OptionKeyDown then begin
                err := SetVol(nil, vnum);
                refNum := OpenResFile(fname);
                if RefNum <> -1 then begin
                        ok1 := LoadCLUTResource(KlutzID);
                        if not ok1 then
                            ok2 := LoadCLUTResource(PixelPaintID);
                        CloseResFile(refNum);
                    end;
            end;
    end;


    procedure Swap2Bytes (var i: integer);
        type
            atype = packed array[1..2] of char;
        var
            a: atype;
            c: char;
    begin
        a := atype(i);
        c := a[1];
        a[1] := a[2];
        a[2] := c;
        i := integer(a)
    end;


    procedure Swap4Bytes (var i: LongInt);
        var
            a: ostype;
            c: char;
    begin
        a := ostype(i);
        c := a[1];
        a[1] := a[4];
        a[4] := c;
        c := a[2];
        a[2] := a[3];
        a[3] := c;
        i := LongInt(a)
    end;


    procedure GetTiffEntry (f: integer; var tag: integer; var value: LongInt);
        var
            IFDEntry: TiffEntry;
            ByteCount: LongInt;
            IntValue: integer;
            err: OSErr;
    begin
        ByteCount := 12;
        err := FSRead(f, ByteCount, @IFDEntry);
        with IFDEntry do begin
                tag := TagField;
                if IntelByteOrder then
                    Swap2Bytes(tag);
                value := offset;
                if ftype = short then begin
                        value := bsr(value, 16);
                        if IntelByteOrder then begin
                                IntValue := value;
                                Swap2Bytes(IntValue);
                                value := IntValue
                            end
                    end
                else if IntelByteOrder then
                    Swap4Bytes(value);
  {dl(tag); dl(ftype); dl(length); dl(value); dnl;}
            end;
    end;


    function OpenTiffHeader (f: integer): boolean;
        var
            TiffHeader: TiffHdr;
            offset, ByteCount, length, ftype, value: LongInt;
            err: OSErr;
            nEntries, i, tag: integer;
    begin
        ByteCount := 8;
        err := SetFPos(f, fsFromStart, 0);
        err := fsread(f, ByteCount, @TiffHeader);
        with TiffHeader do begin
                IntelByteOrder := ByteOrder = 'II';
                if (ByteOrder <> 'MM') and (ByteOrder <> 'II') then begin
                        PutMessage('Invalid TIFF header.', '', '');
                        OpenTiffHeader := false;
                        exit(OpenTiffHeader)
                    end;
                offset := FirstIFDOffset;
                if IntelByteOrder then
                    Swap4Bytes(offset);
                err := SetFPos(f, fsFromStart, Offset);
                if IOCheck(err) <> NoErr then begin
                        OpenTiffHeader := false;
                        exit(OpenTiffHeader);
                    end;
                ByteCount := 2;
                err := FSRead(f, ByteCount, @nEntries);
                if IntelByteOrder then
                    Swap2Bytes(nEntries);
                with info^ do begin
                        PixelsPerLine := 0;
                        nLines := 0;
                        offset := 0;
                        for i := 1 to nEntries do begin
                                GetTiffEntry(f, tag, value);
                                if tag = 0 then begin
                                        PutMessage('Invalid TIFF format.', '', '');
                                        OpenTiffHeader := false;
                                        exit(OpenTiffHeader)
                                    end;
                                case tag of
                                    ImageWidth:
                                        PixelsPerLine := value;
                                    ImageLength:
                                        nLines := value;
                                    BitsPerSample:
                                        begin
                                            if value = 4 then
                                                PictureType := FourBitTiff;
                                            if value = 1 then begin
                                                    PutMessage('Image cannot open 1-bit TIFF files.', '', '');
                                                    OpenTiffHeader := false;
                                                    exit(OpenTiffHeader)
                                                end;
                                        end;
                                    Compression:
                                        if value <> 1 then begin
                                                PutMessage('Image cannot open compressed TIFF files.', '', '');
                                                OpenTiffHeader := false;
                                                exit(OpenTiffHeader)
                                            end;
                                    PhotoInterp:
                                        if (value = 1) and (PictureType <> FourBitTIFF) then
                                            PictureType := InvertedTiff;
                                    StripOffsets:
                                        ImageDataOffset := value;
                                    RowsPerStrip:
                                        if value < nLines then begin
                                                PutMessage('Image cannot open TIFF files with multiple strips.', '', '');
                                                OpenTiffHeader := false;
                                                exit(OpenTiffHeader)
                                            end;
                                    ImageHdrTag:
                                        HeaderOffset := value;
                                    otherwise
                                end;
                            end; {for}
                    end; {with}
            end;
        OpenTiffHeader := true;
    end;


    function OpenImageHeader (f: integer; fname: str255; vnum: integer): boolean;
        var
            ByteCount: LongInt;
            err: OSErr;
            TempHdr: PicHeader;
            i, OldNExtra: integer;
            ok: boolean;
    begin
        ByteCount := 512;
        err := SetFPos(f, fsFromStart, info^.HeaderOffset);
        err := fsread(f, ByteCount, @TempHdr);
        if IOCheck(err) <> NoErr then begin
                OpenImageHeader := false;
                exit(OpenImageHeader);
            end;
        with info^, TempHdr do begin
                if PictureType <> TiffFile then begin
                        nlines := hnlines;
                        PixelsPerLine := hPixelsPerLine;
                    end;
                if hversion > 54 then begin
                        OldNExtra := nExtraColors;
                        nExtraColors := hnExtraColors;
                        ExtraColors := hExtraColors;
                        if (nExtraColors > 0) or (OldNExtra <> nExtraColors) then
                            RedrawCLUTWindow;
                    end;
                if (hversion >= 42) and not OptionKeyDown then begin
                        LUTMode := hLUTMode;
                        case LUTMode of
                            Colorpalette:
                                begin
                                    nColors := hncolors;
                                    CheckColorWidth;
                                    for i := 0 to ncolors - 1 do begin
                                            RedX[i] := hr[i] * 255;
                                            GreenX[i] := hg[i] * 255;
                                            BlueX[i] := hb[i] * 255;
                                        end;
                                    ColorStart := hColorStart;
                                    ColorWidth := hColorWidth;
                                    UpdateColors;
                                end;
                            AppleDefault:
                                ok := LoadCLUTResource(AppleDefaultCLUT);
                            Spectrum:
                                Load256ColorCLUT;
                            GrayScale:
                                ResetGrayMap;
                            Custom, CustomGrayscale:
                                if PictureType <> PictFile then
                                    LookForCluts(fname, vnum);
                        end; {case}
                        if hLutMode = CustomGrayscale then
                            LutMode := CustomGrayscale;
                    end;{if}
                if (hversion >= 65) and ((ForegroundColor <> hForegroundColor) or (BackgroundColor <> hBackgroundColor)) then begin
                        SetForegroundColor(hForegroundColor);
                        SetBackgroundColor(hBackgroundColor);
                    end;
                if (hversion > 88) and (LUTMode = GrayScale) then begin
                        p1x := hp1x;
                        p1y := hp1y;
                        p2x := hp2x;
                        p2y := hp2y;
                        SetGrayScaleLUT;
                    end;
                if hversion > 106 then
                    scale := hScale;
                units := hUnits;
                UnitsID := hUnitsID;
                if UnitsID = 0 then begin
                        UnitsID := 7;
                        units := 'mm';
                    end;
                if hnCoefficients > 0 then begin
                        fit := hfit;
                        nCoefficients := hnCoefficients;
                        Coefficient := hCoeff;
                        UnitOfMeasure := hUM;
                        Calibrated := true;
                        GenerateValues;
                    end
                else
                    Calibrated := false;
                RestoringOutline := hContainsOutline;
                BinaryPic := hBinaryPic;
                OpenImageHeader := true
            end;
    end;


    function OpenHeader (f: integer; fname: str255; vnum: integer): boolean;
        var
            ByteCount: LongInt;
            hdr: packed array[1..512] of byte;
            err: OSErr;
            TempHdr: PicHeader;
    begin
        with info^ do begin
                if (WhatToOpen = OpenUnknown) or (WhatToOpen = OpenImported) then begin
                        err := SetFPos(f, fsFromStart, 0);
                        ByteCount := 8;
                        err := fsread(f, ByteCount, @hdr);
                        if ((hdr[1] = 73) and (hdr[2] = 73)) or ((hdr[1] = 77) and (hdr[2] = 77)) then
                            WhatToOpen := OpenTIFF
                        else if WhatToOpen = OpenUnknown then
                            WhatToOpen := OpenImage
                        else
                            WhatToOpen := OpenMCID;
                    end;
                case WhatToOpen of
                    OpenImage:
                        begin
                            err := SetFPos(f, fsFromStart, 0);
                            ByteCount := 8;
                            err := fsread(f, ByteCount, @TempHdr);
                            if TempHdr.FileID = FileID8 then begin
                                    HeaderOffset := 0;
                                    PictureType := normal
                                end
                            else begin
                                    HeaderOffset := -1;
                                    BlockMove(@TempHdr, @hdr, 8);
                                    nlines := hdr[1] + hdr[2] * 256;
                                    PixelsPerLine := hdr[3] + hdr[4] * 256;
                                    PictureType := PDP11;
                                end;
                            ImageDataOffset := 512;
                        end;
                    OpenMCID:
                        begin
                            err := SetFPos(f, fsFromStart, 0);
                            ByteCount := 4;
                            err := fsread(f, ByteCount, @hdr);
                            PixelsPerLine := hdr[1] + hdr[2] * 256 + 1;
                            if PixelsPerLine > MaxPixelsPerLine then begin
                                    beep;
                                    PixelsPerLine := MaxPixelsPerLine;
                                end;
                            nlines := hdr[3] + hdr[4] * 256 + 1;
                            PictureType := imported;
                            LUTMode := grayscale;
                            HeaderOffset := -1;
                            ImageDataOffset := 4;
                        end;
                    OpenCustom:
                        begin
                            PixelsPerLine := ImportCustomWidth;
                            nlines := ImportCustomHeight;
                            PictureType := imported;
                            HeaderOffset := -1;
                            ImageDataOffset := ImportCustomOffset;
                        end;
                    OpenPICT2:
                        begin
                            err := SetFPos(f, fsFromStart, 0);
                            ByteCount := 8;
                            err := fsread(f, ByteCount, @TempHdr);
                            if TempHdr.FileID = FileID8 then
                                HeaderOffset := 0
                            else
                                HeaderOffset := -1;
                            PictureType := PictFile;
                            LutMode := custom;
                            ImageDataOffset := 512;
                        end;
                    OpenTIFF:
                        begin
                            PictureType := TiffFile;
                            ImageDataOffset := 0;
                            HeaderOffset := -1;
                            nlines := 100;
                            PixelsPerLine := 100;
                            if not OpenTiffHeader(f) then begin
                                    OpenHeader := false;
                                    exit(OpenHeader)
                                end;
                            LutMode := Grayscale;
                        end;
                end; {case}
                if HeaderOffset <> -1 then begin
                        if not OpenImageHeader(f, fname, vnum) then begin
                                OpenHeader := false;
                                exit(OpenHeader)
                            end
                    end
                else
                    calibrated := false;
            end; {with}
        OpenHeader := true;
    end;


    function SaveHeader (f, slines, sPixelsPerLine, vnum: integer; fname: str255; SavingSelection, SavingTIFF: boolean): OSErr;
        var
            TempHdr: PicHeader;
            DummyHdr: array[1..128] of LongInt;
            i: integer;
            ByteCount: LongInt;
            position: LongInt;
            err: OSErr;
            str: str255;
    begin
        with TempHdr, info^ do begin
                for i := 1 to 128 do
                    DummyHdr[i] := 0;
                BlockMove(@DummyHdr, @TempHdr, HeaderSize);
                FileID := FileID8;
                hnlines := nlines;
                hPixelsPerLine := PixelsPerLine;
                hversion := version;
                hLUTMode := LUTMode;
                hnColors := ncolors;
                if LUTMode = ColorPalette then
                    for i := 0 to nColors - 1 do begin
                            hr[i] := BSR(RedX[i], 8);
                            hg[i] := BSR(GreenX[i], 8);
                            hb[i] := BSR(BlueX[i], 8);
                        end;
                hColorStart := ColorStart;
                hColorWidth := ColorWidth;
                hnExtraColors := nExtraColors;
                hExtraColors := ExtraColors;
                hForegroundColor := ForegroundColor;
                hBackgroundColor := BackgroundColor;
                hScale := scale;
                hUnits[1] := units[1];
                hUnits[2] := units[2];
                hUnitsID := UnitsID;
                hp1x := p1x;
                hp1y := p1y;
                hp2x := p2x;
                hp2y := p2y;
                if nCoefficients > 0 then begin
                        hfit := fit;
                        hnCoefficients := nCoefficients;
                        hCoeff := Coefficient;
                        hUM := UnitOfMeasure;
                    end;
                hContainsOutline := SavingOutline;
                hBinaryPic := BinaryPic;
                ByteCount := SizeOf(TempHdr);
                if ByteCount <> HeaderSize then begin
                        NumToString(ByteCount, str);
                        PutMessage('Internal error check: header size is incorrect.  Size=', str, '');
                        ExitToShell;
                    end;
                if SavingSelection then begin
                        hnlines := slines;
                        hPixelsPerLine := sPixelsPerLine;
                    end;
                err := fswrite(f, ByteCount, @TempHdr);
                SaveHeader := IOCheck(err);
                if ((LutMode = Custom) or (LutMode = CustomGrayscale)) and SavingTIFF then
                    SaveCustomClut(fname, vnum);
            end; {with}
    end;


    function SaveTiffDirectory (f, slines, sPixelsPerLine: integer; SavingSelection: boolean): OSErr;
        var
            err: integer;
            ByteCount, width, height: LongInt;
    begin
        with info^ do begin
                if SavingSelection then begin
                        width := sPixelsPerLine;
                        height := sLines
                    end
                else begin
                        width := PixelsPerLine;
                        height := nLines
                    end;
                with TiffInfo do begin
                        directory[2].offset := bsl(width, 16);
                        directory[3].offset := bsl(height, 16);
                    end;
            end;
        ByteCount := SizeOf(TiffInfo);
        err := SetFPos(f, FSFromStart, 0);
        err := FSWrite(f, ByteCount, @TiffInfo);
        SaveTiffDirectory := IOCheck(err);
    end;


    function SaveTiffFile (fname: str255; vnum: integer; slines, sPixelsPerLine: integer; SavingSelection: boolean): boolean;
        var
            f, err, i: integer;
            HdrSize, ByteCount, SelectionSize: LongInt;
            TheInfo: FInfo;
    begin
        SaveTiffFile := false;
        if Info = NoInfo then begin
                beep;
                exit(SaveTiffFile)
            end;
        ShowWatch;
        err := fsopen(fname, vNum, f);
        if IOCheck(err) <> 0 then
            exit(SaveTiffFile);
        with Info^ do begin
                if SaveTiffDirectory(f, slines, sPixelsPerLine, SavingSelection) <> NoErr then begin
                        err := fsclose(f);
                        err := FSDelete(fname, vnum);
                        exit(SaveTiffFile)
                    end;
                err := SetFPos(f, FSFromStart, TiffDirSize);
                if SaveHeader(f, slines, sPixelsPerLine, vnum, fname, SavingSelection, true) <> NoErr then begin
                        err := fsclose(f);
                        err := FSDelete(fname, vnum);
                        exit(SaveTiffFile)
                    end;
                if SavingSelection then begin
                        SelectionSize := LongInt(slines) * sPixelsPerLine;
                        ByteCount := SelectionSize;
                        err := fswrite(f, ByteCount, UndoBuf)
                    end
                else begin
                        ByteCount := PicSize;
                        err := fswrite(f, ByteCount, PicBaseAddr);
                        SelectionSize := 0
                    end;
                if IOCheck(err) <> 0 then begin
                        err := fsclose(f);
                        err := FSDelete(fname, vnum);
                        exit(SaveTiffFile)
                    end;
                HdrSize := HeaderSize + TiffDirSize;
                if SavingSelection then
                    err := SetEOF(f, SelectionSize + HdrSize)
                else
                    err := SetEOF(f, PicSize + HdrSize);
                err := fsclose(f);
                err := GetFInfo(fname, vnum, TheInfo);
                if TheInfo.fdCreator <> 'IMAG' then begin
                        TheInfo.fdCreator := 'IMAG';
                        err := SetFInfo(fname, vnum, TheInfo);
                    end;
                if TheInfo.fdType <> 'TIFF' then begin
                        TheInfo.fdType := 'TIFF';
                        err := SetFInfo(fname, vnum, TheInfo);
                    end;
                err := FlushVol(nil, vNum);
                if not SavingSelection then begin
                        if (PictureType <> Camera) and (PictureType <> BlankField) then begin
                                PictureType := normal;
                                SetWTitle(wptr, fname);
                                title := fname;
                                vref := vnum;
                            end;
                    end;
                Changes := false;
            end; {with}
        SaveTiffFile := true;
    end;


    procedure UpdateWindowsMenuItem (PicSize: LongInt; title: str255; PicNum: integer);
        var
            str: str255;
    begin
        if PicNum <= MaxPicsInMenu then begin
                NumToString(PicSize div 1024, str);
                str := concat(title, '  ', str, 'K');
                SetItem(WindowsMenuH, PicNum + nItems, str);
            end;
    end;


    procedure SaveTiffAs;{(slines,sPixelsPerLine:integer; SavingSelection:boolean)}
        var
            err: integer;
            where: Point;
            reply: SFReply;
            TheInfo: FInfo;
            replacing, ok: boolean;
            name: str255;
    begin
        if Info = NoInfo then begin
                beep;
                exit(SaveTiffAs)
            end;
        where.v := 50;
        where.h := 50;
        name := info^.title;
        if name = 'Camera' then
            name := 'Untitled';
        SFPutFile(Where, 'Save as?', name, nil, reply);
        if not reply.good then
            exit(SaveTiffAs);
        err := GetFInfo(reply.fname, reply.vRefNum, TheInfo);
        case err of
            NoErr:
                with TheInfo do begin
                        if (fdType <> 'TIFF') and (fdType <> 'PICT') and (fdType <> 'IPIC') then begin
                                TypeMismatch(reply.fname);
                                exit(SaveTiffAs)
                            end;
                        replacing := true;
                    end;
            FNFerr:
                begin
                    err := create(reply.fname, reply.vRefNum, 'IMAG', 'TIFF');
                    if IOCheck(err) <> 0 then
                        exit(SaveTiffAs);
                    replacing := false;
                end;
            otherwise
                if IOCheck(err) <> 0 then
                    exit(SaveTiffAs);
        end;
        ok := SaveTiffFile(reply.fname, reply.vRefNum, slines, sPixelsPerLine, SavingSelection);
        if ok then
            with info^ do
                UpdateWindowsMenuItem(PicSize, title, PicNum);
        with info^ do
            if SavingSelection and Replacing and (PictureType <> Camera) and (PictureType <> BlankField) then
                PictureType := Leftover;
    end;


    function SavePICTFile (fname: str255; vnum: integer; SavingSelection: boolean): boolean;
        var
            f, err, i, v: integer;
            ByteCount, PICTSize: LongInt;
            PicH: PicHandle;
            fRect, frect2: rect;
            tPort: GrafPtr;
            TheInfo: FInfo;
    begin
        if OpPending then
            KillRoi;
        SavePICTFile := false;
        ShowWatch;
        err := fsopen(fname, vnum, f);
        err := SetFPos(f, FSFromStart, 0);
        if SaveHeader(f, 0, 0, vnum, fname, SavingSelection, false) <> 0 then begin
                err := fsclose(f);
                err := FSDelete(fname, vnum);
                exit(SavePICTFile)
            end;
        with info^ do begin
                GetPort(tPort);
                if SavingSelection then
                    fRect := osRoiRect
                else
                    SetRect(fRect, 0, 0, PixelsPerLine, nlines);
                with frect do
                    SetRect(frect2, 0, 0, right - left, bottom - top);
                with osPort^ do begin
                        SetPort(GrafPtr(osPort));
                        ClipRect(PicRect);
                        LoadLUT(info^.cTable);  {Restore look-up table in case it has changed.}
                        PicH := OpenPicture(fRect2);
                        if SavingOutline then begin
                                PenNormal;
                                FrameRgn(info^.osroiRgn);
                                SavingOutline := false
                            end
                        else begin
                                hlock(handle(PortPixMap));
                                CopyBits(BitMapHandle(PortPixMap)^^, BitMapHandle(PortPixMap)^^, frect, frect2, SrcCopy, nil);
                                hunlock(handle(PortPixMap));
                            end;
                        ClosePicture;
                    end;
                SetPort(tPort);
                PICTSize := GetHandleSize(handle(PicH));
                if PICTSize <= 0 then begin
                        err := fsclose(f);
                        err := FSDelete(fname, vnum);
                        exit(SavePICTFile)
                    end;
                err := fswrite(f, PICTSize, pointer(PicH^));
                if IOCheck(err) <> 0 then begin
                        err := fsclose(f);
                        err := FSDelete(fname, vnum);
                        exit(SavePICTFile)
                    end;
                DisposHandle(handle(PicH));
                ByteCount := PICTSize + HeaderSize;
                err := SetEOF(f, ByteCount);
                err := fsclose(f);
                err := GetFInfo(fname, vnum, TheInfo);
                if TheInfo.fdCreator <> 'IMAG' then begin
                        TheInfo.fdCreator := 'IMAG';
                        err := SetFInfo(fname, vnum, TheInfo);
                    end;
                if TheInfo.fdType <> 'PICT' then begin
                        TheInfo.fdType := 'PICT';
                        err := SetFInfo(fname, vnum, TheInfo);
                    end;
                err := FlushVol(nil, vnum);
                if not SavingSelection then begin
                        if (PictureType <> Camera) and (PictureType <> BlankField) then begin
                                PictureType := PictFile;
                                SetWTitle(wptr, fname);
                                title := fname;
                                vref := vnum;
                            end;
                        Changes := false;
                    end;
            end; {with}
        SavePICTFile := true;
    end;


    procedure SaveFile;
        var
            fname: str255;
            size: LongInt;
            ok: boolean;
    begin
        if Info = NoInfo then begin
                beep;
                exit(SaveFile)
            end;
        if OpPending then
            KillRoi;
        with Info^ do begin
                GetWTitle(wptr, fname);
                size := 0;
                if PictureType = TiffFile then
                    ok := SaveTiffFile(fname, vref, 0, 0, false)
                else if PictureType = PictFile then
                    ok := SavePICTFile(fname, vref, false)
                else
                    SaveTiffAs(0, 0, false);
            end;
    end;


    procedure SavePICTAs;{(SavingSelection:boolean)}
        var
            f, err, i: integer;
            where: Point;
            reply: SFReply;
            TheInfo: FInfo;
            replacing, ok: boolean;
            name: str255;
    begin
        if info = NoInfo then begin
                beep;
                exit(SavePictAs)
            end;
        where.v := 50;
        where.h := 50;
        name := info^.title;
        if name = 'Camera' then
            name := 'Untitled';
        SFPutFile(Where, 'Save as?', name, nil, reply);
        if not reply.good then
            exit(SavePictAs);
        err := GetFInfo(reply.fname, reply.vRefNum, TheInfo);
        case err of
            NoErr:
                with TheInfo do begin
                        if (fdType <> 'TIFF') and (fdType <> 'PICT') and (fdType <> 'IPIC') then begin
                                TypeMismatch(reply.fname);
                                exit(SavePictAs)
                            end;
                        replacing := true;
                    end;
            FNFerr:
                begin
                    err := create(reply.fname, reply.vRefNum, 'IMAG', 'PICT');
                    if IOCheck(err) <> 0 then
                        exit(SavePictAs);
                    replacing := false;
                end;
            otherwise
                if IOCheck(err) <> 0 then
                    exit(SavePictAs);
        end;
        ok := SavePICTFile(reply.fname, reply.vRefNum, SavingSelection);
        if ok then
            with info^ do
                UpdateWindowsMenuItem(PicSize, title, PicNum);
        with info^ do
            if SavingSelection and replacing and (PictureType <> Camera) and (PictureType <> BlankField) then
                PictureType := Leftover;
    end;


    procedure SaveSelection;{(SaveAsSameType:boolean)}
        var
            size, offset: LongInt;
            i, slines, spixelsPerLine, hstart, vstart: integer;
            src, dst: ptr;
    begin
        if NoSelection or NotRectangular or NotInBounds then
            exit(SaveSelection);
        if OpPending then
            KillRoi;
        with info^ do begin
                with osRoiRect do begin
                        sPixelsPerLine := right - left;
                        if odd(sPixelsPerLine) and (left + sPixelsPerLine < PicRect.right) then
                            sPixelsPerLine := sPixelsPerLine + 1;
                        slines := bottom - top;
                        size := LongInt(slines) * sPixelsPerLine;
                        hstart := left;
                        vstart := top;
                    end;
                if (PictureType <> PictFile) or not SaveAsSameType then begin
                        if size > UndoBufSize then begin
                                PutMessage('There is not enough memory available to save the selection', '', '');
                                exit(SaveSelection)
                            end;
                        offset := LongInt(vstart) * BytesPerRow + hstart;
                        src := ptr(ord4(PicBaseAddr) + offset);
                        dst := UndoBuf;
                        for i := 0 to slines - 1 do begin
                                BlockMove(src, dst, sPixelsPerLine);
                                src := ptr(ord4(src) + BytesPerRow);
                                dst := ptr(ord4(dst) + sPixelsPerLine);
                            end;
                    end;
                if (PictureType = PictFile) and SaveAsSameType then
                    SavePICTAs(true)
                else
                    SaveTiffAs(slines, sPixelsPerLine, true);
            end;
    end;


    procedure SaveCameraWindow;
    begin
        SelectAll(true);
        SaveSelection(false);
        KillRoi;
        info^.changes := false
    end;


    function SaveChanges: integer;
        const
            yesID = 1;
            noID = 2;
            cancelID = 3;
        var
            id: integer;
    begin
        id := 0;
        if info^.changes then
            with info^ do begin
                    ParamText(title, '', '', '');
                    InitCursor;
                    id := alert(600, nil);
                    if id = yesID then begin
                            if info^.PictureType <> Camera then
                                SaveFile
                            else begin
                                    SelectAll(false);
                                    SaveSelection(true);
                                    changes := false
                                end;
                            InitCursor;
                        end;
                end;
        if (id = cancelID) or ((id = yesID) and (info^.changes)) then
            SaveChanges := cancel
        else
            SaveChanges := ok;
    end;


    function CloseAWindow (WhichWindow: WindowPtr): integer;
        var
            i, kind, n: integer;
            TempInfo: InfoPtr;
            SizeStr, str: str255;
            wp: ^WindowPtr;
    begin
        kind := WindowPeek(WhichWindow)^.WindowKind;
        CloseAWindow := ok;
        case kind of
            PicKind:
                with Info^ do begin
                        Info := pointer(WindowPeek(WhichWindow)^.RefCon);
                        if SaveChanges = cancel then begin
                                CloseAWindow := cancel;
                                exit(CloseAWindow)
                            end;
                        if PicNum <= MaxPicsInMenu then
                            DelMenuItem(WindowsMenuH, PicNum + nItems);
                        for i := PicNum to nPics - 1 do begin
                                PicWindow[i] := PicWindow[i + 1];
                                TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
                                TempInfo^.PicNum := i
                            end;
                        if (PicNum <= MaxPicsInMenu) and (nPics > MaxPicsInMenu) then begin
                                TempInfo := pointer(WindowPeek(PicWindow[MaxPicsInMenu])^.RefCon);
                                with TempInfo^ do begin
                                        NumToString(PicSize div 1024, SizeStr);
                                        str := concat(title, '  ', SizeStr, 'K');
                                        AppendMenu(WindowsMenuH, ' ');
                                        InsertMenu(WindowsMenuH, 0);
                                    end;
                            end;
                        if PictureType = camera then
                            CameraInfo := nil
                        else
                            DisposPtr(PicBaseAddr);
                        if PictureType = BlankField then
                            BlankFieldInfo := nil;
                        if PictureType = DebugWindow then
                            DebugInfo := nil;
                        if PictureType = ScionType then
                            ScionInfo := nil;
                        DisposeWindow(WhichWindow);
                        CloseCPort(osPort);
                        Dispose(osPort);
                        DisposeRgn(osroiRgn);
                        nPics := nPics - 1;
                        OpPending := false;
                        DisposPtr(pointer(Info));
                        Info := NoInfo;
                        if (nPics = 0) and (not finished) then
                            with info^ do begin
                                    LoadLUT(info^.cTable);
                                    if (LutMode = GrayScale) or (LutMode = CustomGrayScale) then
                                        DrawGrayMap;
                                end;
                    end;
            HistoKind:
                begin
                    DisposeWindow(HistoWindow);
                    HistoWindow := nil;
                    ContinuousHistogram := false;
                    SetMenuItem(GetMHandle(WindowsMenu), 7, false);
                end;
            ProfilePlotKind, CalibrationPlotKind:
                begin
                    DisposeWindow(PlotWindow);
                    PlotWindow := nil;
                    KillPicture(PlotPICT);
                    PlotPICT := nil;
                    SetMenuItem(GetMHandle(WindowsMenu), 8, false);
                end;
            PasteControlKind:
                begin
                    DisposeWindow(PasteControl);
                    PasteControl := nil;
                    wp := pointer(GhostWindow);
                    wp^ := nil;
                    SetMenuItem(GetMHandle(WindowsMenu), 9, false);
                end;
        end; {case}
    end;


    procedure Read4BitTIFF (f: integer);
        var
            vloc, hloc, i: integer;
            ByteCount, count: LongInt;
            err: OSErr;
            UnpackedLine, PackedLine: LineType;
    begin
        with info^ do begin
                if PixelsPerLine > MaxPixelsPerLine then
                    exit(Read4BitTIFF);
                ByteCount := (PixelsPerLine + 1) div 2;
                for vloc := 0 to nLines - 1 do begin
                        err := FSRead(f, ByteCount, @PackedLine);
                        i := 0;
                        for hloc := 0 to PixelsPerLine - 1 do
                            if odd(hloc) then begin
                                    UnpackedLine[hloc] := bsl(band(PackedLine[i], $F), 4);
                                    i := i + 1;
                                end
                            else
                                UnpackedLine[hloc] := band(PackedLine[i], $F0);
                        PutLine(0, vloc, PixelsPerLine, UnpackedLine);
                    end;
            end; {with}
    end;


    procedure OpenFile;{(fname:str255; vnum:integer)}
        var
            ticks, ByteCount, i: LongInt;
            err: OSErr;
            f: integer;
            line, pixel: integer;
            r2, r3: rect;
            p: ptr;
            value: byte;
            iptr: ptr;
    begin
        ShowWatch;
        err := fsopen(fname, vNum, f);
        SaveInfo := Info;
        iptr := NewPtr(SizeOf(PicInfo));
        if iptr = nil then begin
                PutOutOfMemMsg;
                DisposPtr(iptr);
                err := fsclose(f);
                exit(OpenFile)
            end;
        Info := pointer(iptr);
        info^ := SaveInfo^;
        with Info^ do begin
                if not OpenHeader(f, fname, vnum) then begin
                        DisposPtr(iptr);
                        err := fsclose(f);
                        Info := SaveInfo;
                        exit(OpenFile)
                    end;
                PicSize := LongInt(nlines) * PixelsPerLine;
                PicBaseAddr := Getmemory(PicSize);
                if PicBaseAddr = nil then begin
                        err := fsclose(f);
                        exit(OpenFile)
                    end;
                MakeNewWindow(fname);
                err := SetFPos(f, fsFromStart, ImageDataOffset);
                if PictureType = FourBitTIFF then
                    Read4BitTIFF(f)
                else
                    err := fsread(f, PicSize, PicBaseAddr);
                if (PictureType = pdp11) or (PictureType = imported) or (PictureType = InvertedTIFF) then
                    InvertPic;
                if PictureType = FourBitTIFF then
                    PictureType := imported;
    {Picture will be copied to the screen by DoUpdate}
                vref := vnum;
                if PicSize > UndoBufSize then
                    PutWarning;
            end; {with}
        err := fsclose(f);
        SetupUndo;
    end;


    procedure InitPictBuffer (howBig: LongInt);
    begin
        repeat
            PictBuffer := NewPtr(howBig);
            if PictBuffer = nil then
                howBig := howBig div 2;
        until PictBuffer <> nil;
        DisposPtr(PictBuffer);
        PictBuffer := NewPtr(howBig div 2);
    end;


    procedure FillPictBuffer;
        var
            count: LongInt;
            err: OSErr;
    begin
        count := GetPtrSize(PictBuffer);
        if not fitsInPictBuffer then
            err := FSRead(PictF, count, PictBuffer);
        bytesInPictBuffer := count;
        curPictBufPtr := PictBuffer;
    end;


    procedure GetPICTData (dataPtr: Ptr; byteCount: Integer);
    {Input picture spooler routine taken from Apple's PICTViewer example program.}
        var
            count: LongInt;
            anErr: OSErr;
    begin
        count := byteCount;
        repeat
            if bytesInPictBuffer >= count then begin
                    BlockMove(curPictBufPtr, dataPtr, count);
                    curPictBufPtr := Ptr(Ord4(curPictBufPtr) + count);
                    bytesInPictBuffer := bytesInPictBuffer - count;
                    count := 0;
                end
            else begin        {Not enough in buffer}
                    if bytesInPictBuffer > 0 then begin
                            BlockMove(curPictBufPtr, dataPtr, bytesInPictBuffer);
                            dataPtr := Ptr(Ord4(dataPtr) + bytesInPictBuffer);
                            count := count - bytesInPictBuffer;
                        end;
                    FillPictBuffer;
                end;
        until count = 0;
    end;


    procedure BitInfo (var srcBits: PixMap; var srcRect, dstRect: rect; mode: integer; maskRgn: rgnHandle);
        var
            i, size: integer;
    begin
        if BitInfoCount = 0 then
            if srcBits.rowBytes < 0 then
                with srcBits.pmTable^^ do begin{Make sure it is a PixMap.}
                        size := ctSize;
                        if size > 255 then
                            size := 255;
                        if size > 0 then
                            BitInfoCount := BitInfoCount + 1;
                        for i := 0 to size do
                            info^.cTable[i].rgb := ctTable[i].rgb;
                        if size > 0 then
                            info^.LutMode := custom;
                    end;
    end;


    procedure GetClutFromPict (thePict: PicHandle);
  {Refer to "Screen Dump FKEY for Color Picts", February 1988 MacTutor.}
        type
            myPicData = record
                    p: Picture;
                    ID: integer
                end;
            myPicPtr = ^myPicData;
            myPicHdl = ^myPicPtr;
        var
            tempProcs: CQDProcs;
            SaveProcsPtr: QDProcsPtr;
            tPort: GrafPtr;
            err: osErr;
    begin
        with info^ do begin
                GetPort(tPort);
                SetPort(wptr);
                SaveProcsPtr := pointer(wptr^.grafProcs);
                SetStdCProcs(tempProcs);
                tempProcs.bitsProc := @BitInfo;
                tempProcs.getPicProc := @GetPICTData;
                BitInfoCount := 0;
                wptr^.grafProcs := @tempProcs;
                err := SetFPos(PictF, fsFromStart, 512 + SizeOf(Picture));
                FillPictBuffer;
                DrawPicture(thePict, thePict^^.picFrame);
                SetPort(tPort);
                wptr^.grafProcs := pointer(SaveProcsPtr);
            end;
        LoadLUT(info^.cTable);
    end;


    function isGrayScaleCLUT: boolean;
        var
            i: integer;
            GrayScaleCLUT: boolean;
    begin
        GrayscaleClut := true;
        i := 0;
        repeat
            with info^.cTable[i].rgb do
                GrayscaleClut := GrayscaleClut and (red = green) and (green = blue);
            i := i + 1;
        until (i = 256) or not GrayscaleClut;
        isGrayScaleClut := GrayScaleCLUT;
    end;


    procedure RestoreOutline (thePict: PicHandle; pRect: rect);
        var
            tRect: rect;
            temp: integer;
            TempRgn: RgnHandle;
    begin
        with info^ do begin
                RoiShowing := true;
                PenNormal;
                OpenRgn;
                DrawPicture(thePict, pRect);
                CloseRgn(osroiRgn);
                if GetHandleSize(handle(osroiRgn)) = 10 then
                    roiType := RectRoi
                else
                    roiType := RgnRoi;
                osroiRect := osroiRgn^^.rgnBBox;
                roiRect := osroiRect;
                OffscreenToScreenRect(roiRect);
                RestoringOutline := false;
            end;
    end;


    function OpenPict;{(fname:str255; vnum:integer; Reverting:boolean):boolean}
        var
            err: OSErr;
            i: integer;
            value: byte;
            iptr: ptr;
            PictSize, HowBig: LongInt;
            thePict: PicHandle;
            tPort: GrafPtr;
            tempProcs: CQDProcs;
            SaveProcsPtr: QDProcsPtr;

        procedure Abort;
        begin
            if not reverting then begin
                    DisposPtr(pointer(Info));
                    Info := SaveInfo;
                    LoadLUT(info^.cTable);
                end;
            if thePict <> nil then
                DisposHandle(handle(thePict));
            if PictF <> 0 then
                err := fsclose(PictF);
            RestoringOutline := false;
            exit(OpenPict);
        end;

    begin
        PictF := 0;
        thePict := nil;
        OpenPict := false;
        ShowWatch;
        SaveInfo := Info;
        err := fsopen(fname, vNum, PictF);
        if IOCheck(err) <> 0 then
            Abort;
        if not Reverting then begin
                iptr := NewPtr(SizeOf(PicInfo));
                if iptr = nil then begin
                        PutOutOfMemMsg;
                        DisposPtr(iptr);
                        err := fsclose(PictF);
                        exit(OpenPict)
                    end;
                Info := pointer(iptr);
                info^ := SaveInfo^;
            end;
        with Info^ do begin
                err := GetEof(PictF, PictSize);
                if IOCheck(err) <> 0 then
                    Abort;
                PictSize := PictSize - 512;
                if PictSize <= 0 then
                    Abort;
                WhatToOpen := OpenPICT2;
                if not OpenHeader(PictF, fname, vnum) then
                    Abort;
                thePict := PicHandle(NewHandle(SizeOf(Picture)));
                if thePict = nil then
                    Abort;
                err := SetFPos(PictF, fsFromStart, 512);
                if IOCheck(err) <> 0 then
                    Abort;
                howBig := SizeOf(Picture);
                err := FSRead(PictF, howBig, Pointer(thePict^));
                with thePict^^.PicFrame do begin
                        nlines := bottom - top;
                        PixelsPerLine := right - left;
                    end;
                PicSize := LongInt(nlines) * PixelsPerLine;
                if not Reverting then begin
                        PicBaseAddr := GetMemory(PicSize);
                        if PicBaseAddr = nil then begin
                                DisposHandle(handle(thePict));
                                err := fsclose(PictF);
                                exit(OpenPict)
                            end;
                        MakeNewWindow(fname);
                    end;
                if (PicSize > UndoBufSize) and (not Reverting) then begin
                        PutWarning;
                        ShowWatch;
                    end;
                err := GetEof(PictF, howBig);
                howBig := howBig - (512 + SizeOf(Picture));
                InitPictBuffer(HowBig * 2);
                if GetPtrSize(PictBuffer) >= howBig then begin
                        err := FSRead(PictF, howBig, PictBuffer);
                        fitsInPictBuffer := true;
                    end
                else
                    fitsInPictBuffer := false;
                if ((LutMode = custom) or (LutMode = CustomGrayscale)) and (not OptionKeyDown) then
                    GetClutFromPict(thePict);
                if isGrayScaleClut then
                    ResetGrayMap;
                GetPort(tPort);
                SetPort(GrafPtr(osPort));
                osPort^.fgColor := BlackC;
                osPort^.bkColor := WhiteC;
                EraseRect(PicRect);
                SaveProcsPtr := pointer(osPort^.grafProcs);
                SetStdCProcs(tempProcs);
                tempProcs.getPicProc := @GetPICTData;
                osPort^.grafProcs := @TempProcs;
                err := SetFPos(PictF, fsFromStart, 512 + SizeOf(Picture));
                FillPictBuffer;
                if RestoringOutline then
                    RestoreOutline(thePict, PicRect)
                else
                    DrawPicture(thePict, PicRect);
                osPort^.grafProcs := pointer(SaveProcsPtr);
                osPort^.fgColor := ForegroundColor;
                osPort^.bkColor := BackgroundColor;
                DisposHandle(handle(thePict));
                DisposPtr(PictBuffer);
                SetPort(tPort);
                vref := vnum;
                PictureType := PictFile;
            end; {with}
        err := fsclose(PictF);
        SetupUndo;
        OpenPict := true;
    end;


    procedure SavePalette;
        var
            err: integer;
            where: Point;
            reply: SFReply;
            TheInfo: FInfo;
            PaletteData: array[1..4] of ColorArray;
            i, f: integer;
            ByteCount: LongInt;
    begin
        if info^.LUTMode <> ColorPalette then begin
                PutMessage('You can only save pseudocolor palettes consisting of 32 or fewer colors.', '', '');
                exit(SavePalette)
            end;
        where.v := 50;
        where.h := 50;
        SFPutFile(Where, 'Save Palette as?', PaletteName, nil, reply);
        if not reply.good then
            exit(SavePalette);
        err := GetFInfo(reply.fname, reply.vRefNum, TheInfo);
        case err of
            NoErr:
                if TheInfo.fdType <> 'ICOL' then begin
                        TypeMismatch(reply.fname);
                        exit(SavePalette)
                    end;
            FNFerr:
                begin
                    err := create(reply.fname, reply.vRefNum, 'IMAG', 'ICOL');
                    if IOCheck(err) <> 0 then
                        exit(SavePalette);
                end;
            otherwise
                if IOCheck(err) <> 0 then
                    exit(SavePalette);
        end;
        with info^ do begin
                PaletteData[1, 0] := ncolors;
                PaletteData[1, 1] := ColorStart;
                PaletteData[1, 2] := ColorWidth;
                for i := 3 to MaxPseudoColorsLessOne do
                    PaletteData[1, i] := 0;
                for i := 0 to MaxPseudoColorsLessOne do begin
                        PaletteData[2, i] := BSR(RedX[i], 8);
                        PaletteData[3, i] := BSR(GreenX[i], 8);
                        PaletteData[4, i] := BSR(BlueX[i], 8);
                    end;
            end;
        with reply do begin
                err := fsopen(fname, vRefNum, f);
                if IOCheck(err) <> 0 then
                    exit(SavePalette);
                err := SetFPos(f, FSFromStart, 0);
                ByteCount := MaxPseudoColors * 4;
                err := fswrite(f, ByteCount, @PaletteData);
                if IOCheck(err) <> 0 then begin
                        err := fsclose(f);
                        err := FSDelete(fname, vRefNum);
                        exit(SavePalette)
                    end;
                err := fsclose(f);
                err := FlushVol(nil, vRefNum);
            end;
    end;


    procedure LoadPseudoColorPalette (fname: str255; vRefNum: integer);
    begin
        InitColor(fname, vRefNum);
        UpdateColors;
    end;


    procedure LoadPalette (FileType: OSType; fname: str255; vnum: integer);
        var
            RefNum: integer;
            ok: boolean;
            err: OSErr;
    begin
        err := SetVol(nil, vnum);
        refNum := OpenResFile(fname);
        if RefNum <> -1 then begin
                if FileType = 'CLUT' then
                    ok := LoadClutResource(KlutzID)
                else
                    ok := LoadClutResource(PixelPaintID);
                CloseResFile(RefNum);
                if isGrayScaleCLUT then begin
                        info^.LutMode := CustomGrayScale;
                        DrawGrayMap;
                    end;
            end;
    end;


    procedure GetFile;
        var
            where: Point;
            reply: SFReply;
            b: boolean;
            NumTypes, vnum: integer;
            sfPtr: ^SFTypeList;
            TypeList: array[0..5] of OSType;
    begin
        KillOperation;
        StopThresholding;
        where.v := 50;
        where.h := 50;
        typeList[0] := 'IPIC';
        typeList[1] := 'PICT';
        typeList[2] := 'TIFF';
        typeList[3] := 'ICOL';
        typeList[4] := 'PX05'; {PixelPaint LUT}
        typeList[5] := 'CLUT';  {Klutz LUT}
        sfPtr := @TypeList;
        if OptionKeyDown or ShiftKeyDown then
            NumTypes := -1 {Show all files}
        else
            NumTypes := 6;
        SFGetFile(Where, '', nil, NumTypes, sfPtr^, nil, reply);
        if reply.good then
            with reply do begin
                    vnum := vRefNum;
                    if ftype = 'IPIC' then begin
                            WhatToOpen := OpenImage;
                            OpenFile(fname, vNum)
                        end
                    else if ftype = 'PICT' then begin
                            b := OpenPICT(fname, vNum, false)
                        end
                    else if ftype = 'TIFF' then begin
                            WhatToOpen := OpenTIFF;
                            OpenFile(fname, vNum)
                        end
                    else if reply.ftype = 'ICOL' then
                        LoadPseudoColorPalette(fname, vNum)
                    else if reply.ftype = 'PX05' then
                        LoadPalette('PX05', fname, vNum)
                    else if reply.ftype = 'CLUT' then
                        LoadPalette('CLUT', fname, vNum)
                    else begin
                            WhatToOpen := OpenUnknown;
                            OpenFile(fname, vNum)
                        end;
                    info^.ScaleToFitWindow := false;
                end;
    end;


    procedure OpenImportedPalette (fname: str255; vnum: integer);
        var
            err: OSErr;
            f, i: integer;
            ByteCount: LongInt;
            ImportedPalette: array[1..3] of packed array[0..255] of byte;
    begin
        StopThresholding;
        err := fsopen(fname, vNum, f);
        ByteCount := 768;
        err := fsRead(f, ByteCount, @ImportedPalette);
        if err = NoErr then
            with info^ do begin
                    for i := 0 to 255 do
                        with cTable[i], cTable[i].rgb do begin
                                value := 0;
                                red := bsl(ImportedPalette[1, i], 8);
                                green := bsl(ImportedPalette[2, i], 8);
                                blue := bsl(ImportedPalette[3, i], 8);
                            end;
                    LoadLUT(cTable);
                    LUTMode := Custom;
                    IdentityFunction := false;
                    if isGrayScaleCLUT then begin
                            info^.LutMode := CustomGrayScale;
                            DrawGrayMap;
                        end;
                end
        else
            beep;
        err := fsClose(f);
    end;


    function FindWhatToImport: boolean;
        const
            TiffID = 3;
            McidID = 4;
            CustomID = 5;
            WidthID = 9;
            HeightID = 10;
            OffsetID = 11;
            PaletteID = 12;
        var
            mylog: DialogPtr;
            item, i: integer;
            SaveWhatToImport: WhatToImportType;
            SaveWidth, SaveHeight: integer;
            SaveOffset: LongInt;

        procedure SetRadioButton;
            var
                i: integer;
        begin
            SetDialogItem(mylog, TiffID, 0);
            SetDialogItem(mylog, McidID, 0);
            SetDialogItem(mylog, PaletteID, 0);
            SetDialogItem(mylog, CustomID, 0);
            case WhatToImport of
                ImportTiff:
                    SetDialogItem(mylog, TiffID, 1);
                ImportMcid:
                    SetDialogItem(mylog, McidID, 1);
                ImportPalette:
                    SetDialogItem(mylog, PaletteID, 1);
                ImportCustom:
                    SetDialogItem(mylog, CustomID, 1);
            end;
        end;

    begin
        InitCursor;
        SaveWhatToImport := WhatToImport;
        SaveWidth := ImportCustomWidth;
        SaveHeight := ImportCustomHeight;
        SaveOffset := ImportCustomOffset;
        mylog := GetNewDialog(7000, nil, pointer(-1));
        SetRadioButton;
        SetDNum(MyLog, WidthID, ImportCustomWidth);
        SelIText(MyLog, WidthID, 0, 32767);
        SetDNum(MyLog, HeightID, ImportCustomHeight);
        SetDNum(MyLog, OffsetID, ImportCustomOffset);
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
            if ((item >= TiffID) and (item <= CustomID)) or (item = PaletteID) then begin
                    case item of
                        TiffID:
                            WhatToImport := ImportTiff;
                        McidID:
                            WhatToImport := ImportMCID;
                        PaletteID:
                            WhatToImport := ImportPalette;
                        CustomID:
                            WhatToImport := ImportCustom;
                    end;
                    SetRadioButton;
                end;
            if item = WidthID then begin
                    ImportCustomWidth := GetDNum(MyLog, WidthID);
                    if (ImportCustomWidth < 0) or (ImportCustomWidth > 2048) then begin
                            ImportCustomWidth := SaveWidth;
                            SetDNum(MyLog, WidthID, ImportCustomWidth);
                        end;
                    WhatToImport := ImportCustom;
                    SetRadioButton;
                end;
            if item = HeightID then begin
                    ImportCustomHeight := GetDNum(MyLog, HeightID);
                    if (ImportCustomHeight < 0) or (ImportCustomHeight > 2048) then begin
                            ImportCustomHeight := SaveHeight;
                            SetDNum(MyLog, HeightID, ImportCustomHeight);
                        end;
                    WhatToImport := ImportCustom;
                    SetRadioButton;
                end;
            if item = OffsetID then begin
                    ImportCustomOffset := GetDNum(MyLog, OffsetID);
                    if ImportCustomOffset < 0 then begin
                            ImportCustomOffset := SaveWidth;
                            SetDNum(MyLog, OffsetID, ImportCustomOffset);
                        end;
                    WhatToImport := ImportCustom;
                    SetRadioButton;
                end;
        until (item = ok) or (item = cancel);
        DisposDialog(mylog);
        if item = cancel then begin
                WhatToImport := SaveWhatToImport;
                ImportCustomWidth := SaveWidth;
                ImportCustomHeight := SaveHeight;
                ImportCustomOffset := SaveOffset;
                FindWhatToImport := false
            end
        else
            FindWhatToImport := true;
    end;


    procedure ImportFile;
        var
            where: Point;
            typeList: SFTypeList;
            reply: SFReply;
    begin
        StopThresholding;
        if FindWhatToImport then begin
                where.v := 50;
                where.h := 50;
                SFGetFile(Where, '', nil, -1, typeList, nil, reply); {Show User all Types}
                if reply.good then begin
                        case WhatToImport of
                            ImportTiff:
                                WhatToOpen := OpenTiff;
                            ImportMCID:
                                WhatToOpen := OpenImported;
                            ImportPalette:
                                OpenImportedPalette(reply.fname, reply.vRefNum);
                            ImportCustom:
                                WhatToOpen := OpenCustom;
                        end;
                        if WhatToImport <> ImportPalette then
                            OpenFile(reply.fname, reply.vRefNum);
                    end;
            end;
    end;


    procedure RevertToSaved;
        var
            fname: str255;
            err, f: integer;
            ok: boolean;
    begin
        if Info = NoInfo then begin
                beep;
                exit(RevertToSaved)
            end;
        if OpPending then
            KillRoi;
        StopThresholding;
        with Info^ do begin
                GetWTitle(wptr, fname);
                if PictureType = PICTFile then begin
                        ok := OpenPICT(fname, vref, true);
                        invalRect(wrect)
                    end
                else begin
                        ShowWatch;
                        err := fsopen(fname, vref, f);
                        ok := true;
                        if HeaderOffset <> -1 then
                            ok := OpenImageHeader(f, fname, vref);
                        if ok then begin
                                err := SetFPos(f, fsFromStart, ImageDataOffset);
                                err := fsread(f, PicSize, PicBaseAddr);
                                with info^ do
                                    if (PictureType = PDP11) or (PictureType = InvertedTIFF) then
                                        InvertPic;
                                InvalRect(wrect);
                            end;
                        err := fsclose(f);
                        RoiShowing := false;
                    end;
                OpPending := false;
                Changes := false;
            end; {with}
    end;


    procedure SaveSettings;
        var
            size: LongInt;
            TempH: handle;
            SettingsH: handle;
    begin
        with settings, info^ do begin
                sForegroundColor := ForegroundColor;
                sBackgroundColor := BackgroundColor;
                sBrushHeight := BrushHeight;
                sBrushWidth := BrushWidth;
                sAirbrushDiameter := AirbrushDiameter;
                sLUTMode := LUTMode;
                sColorStart := ColorStart;
                sColorWidth := ColorWidth;
                sCurrentFontID := CurrentFontID;
                sCurrentStyle := CurrentStyle;
                sCurrentSize := CurrentSize;
                sTextJust := TextJust;
                sTextBack := TextBack;
                sNExtraColors := nExtraColors;
                sExtraColors := ExtraColors;
                sInvertVideo := InvertVideo;
                sMeasurements := Measurements;
                sInvertPlots := InvertPlots;
                sAutoScalePlots := AutoScalePlots;
                sLinePlot := LinePlot;
                sDrawPlotLabels := DrawPlotLabels;
                sProfilePlotMin := ProfilePlotMin;
                sProfilePlotMax := ProfilePlotMax;
                sFixedSizePlot := FixedSizePlot;
                sProfilePlotWidth := ProfilePlotWidth;
                sProfilePlotHeight := ProfilePlotHeight;
                snFrames := nFrames;
                sNewPicWidth := NewPicWidth;
                sNewPicHeight := NewPicHeight;
                sBufferSize := BufferSize;
                sMaxScionWidth := MaxScionWidth;
                sThresholdToForeground := ThresholdToForeground;
                sNonThresholdToBackground := NonThresholdToBackground;
                sVideoChannel := VideoChannel;
                sWhatToImport := WhatToImport;
                sImportCustomWidth := ImportCustomWidth;
                sImportCustomHeight := ImportCustomHeight;
                sImportCustomOffset := ImportCustomOffset;
                sWandAutoMeasure := WandAutoMeasure;
                sWandAutoNumber := WandAutoNumber;
            end;
        SettingsH := GetResource('SETT', 1000);
        if GetHandleSize(SettingsH) > 0 then
            RmveResource(SettingsH);
        size := SizeOF(settings);
        TempH := NewHandle(size);
        BlockMove(@settings, TempH^, size);
        AddResource(TempH, 'SETT', 1000, '');
        WriteResource(TempH);
        if ResError <> NoErr then
            SysBeep(1);
        DisposHandle(TempH);
    end;


    procedure PrintErrCheck;
        var
            err: integer;
            ticks: LongInt;
    begin
        err := PrError;
        if err < 0 then
            beep;
    end;


    procedure DoPageSetup;
        var
            result: boolean;
    begin
        if PrintRecord = nil then begin
                PrintRecord := THPrint(NewHandle(SizeOF(TPrint)));
                PrintDefault(PrintRecord);
            end;
        PrOpen;
        if PrError = NoErr then begin
                result := PrValidate(PrintRecord);
                result := PrStlDialog(PrintRecord);
            end;
        PrClose;
    end;


    procedure PrintHalftone;
        const
            PostScriptBegin = 190;
            PostScriptEnd = 191;
            PostScriptHandle = 192;
            TextIsPostScript = 194;
        var
            HexBufH: handle;
            hloc, vloc, HexCount, iheight, iwidth, hstart, vstart: integer;
            Height, Width, eof, angle, freq: str255;
            aLine: LineType;
            HexBuf: packed array[0..4200] of char;
            err: OSErr;
            table: LookupTable;

        procedure PutHEX (byt: integer);
            var
                i, LowByte, HighByte, tmp: integer;
                h: char;
        begin
            if not IdentityFunction then
                byt := table[byt];
            byt := 255 - byt;
            LowByte := byt mod 16;
            byt := byt div 16;
            HighByte := byt mod 16;
            for i := 1 to 2 do begin
                    if i = 1 then
                        tmp := HighByte
                    else
                        tmp := LowByte;
                    case tmp of
                        0:
                            h := '0';
                        1:
                            h := '1';
                        2:
                            h := '2';
                        3:
                            h := '3';
                        4:
                            h := '4';
                        5:
                            h := '5';
                        6:
                            h := '6';
                        7:
                            h := '7';
                        8:
                            h := '8';
                        9:
                            h := '9';
                        10:
                            h := 'a';
                        11:
                            h := 'b';
                        12:
                            h := 'c';
                        13:
                            h := 'd';
                        14:
                            h := 'e';
                        15:
                            h := 'f';
                    end;
                    hexbuf[HexCount] := h;
                    HexCount := HexCount + 1;
                    if HexCount mod 80 = 0 then begin
                            HexBuf[HexCount] := return;
                            HexCount := HexCount + 1
                        end;
                end;
        end;

    begin
        if not IdentityFunction then
            GetLookupTable(table);
        MoveTo(-1, -1);
        LineTo(-1, -1); {Nothing prints without this dummy dot!}
        with info^ do begin
                PicComment(PostScriptBegin, 0, nil); {See Tech Note #91}
                PicComment(TextIsPostScript, 0, nil);
                NumToString(HalftoneFrequency, freq);
                NumToString(HalftoneAngle, angle);
                if HalftoneDotFunction then
                    DrawString(concat(freq, ' ', angle, ' {dup mul exch dup mul add 1 exch sub} setscreen'))
                else
                    DrawString(concat(freq, ' ', angle, ' {pop} setscreen'));
                DrawString('0 0 translate');
                with osRoiRect do begin
                        iwidth := right - left;
                        iheight := bottom - top;
                        hstart := left;
                        vstart := top;
                    end;
                NumToString(iwidth, width);
                NumToString(iheight, height);
                DrawString(concat(width, ' ', height, ' scale'));
                DrawString(concat('/PicStr ', width, ' string def'));
                DrawString(concat(width, ' ', height, ' 8 [', width, ' 0 0 ', height, ' 0 0]'));
                DrawString('{currentfile PicStr readhexstring pop} image');
                for vloc := vstart to vstart + iheight - 1 do begin
                        GetLine(hstart, vloc, iwidth, aline);
                        HexCount := 0;
                        for hloc := 0 to iwidth - 1 do
                            PutHex(aline[hloc]);
                        HexBuf[HexCount] := return;
                        HexCount := HexCount + 1;
                        err := PtrToHand(@HexBuf, HexBufH, HexCount);
                        if err <> noErr then
                            exit(PrintHalftone);
                        PicComment(PostScriptHandle, HexCount, HexBufH);
                        DisposHandle(HexBufH);
                        Show2Values(vloc - vstart, iheight);
                        if CommandPeriod then begin
                                beep;
                                eof := chr(4);
                                DrawString(eof);
                                exit(PrintHalftone)
                            end;
                    end;
            end;
    end;


    procedure PrintPicture (OptionKeyWasDown: boolean; PageWidth, PageHeight: integer);
        var
            PrintRect: rect;
            Width, Height: integer;
    begin
        if isLaserWriter and (not OptionKeyDown) and (not OptionKeyWasDown) then
            PrintHalftone
        else
            with info^ do begin
                    LoadLUT(cTable);
                    hlock(handle(osPort^.portPixMap));
                    if BitAnd(thePort^.portBits.rowBytes, $8000) = $8000 then begin
        {Assume driver understands Color QD}
                            with osroiRect do begin
                                    width := right - left;
                                    height := bottom - top;
                                end;
                            with PrintRect do begin
                                    left := 0;
                                    top := 0;
                                    if width < PageWidth then
                                        left := (PageWidth - width) div 2;
                                    if height < PageHeight then
                                        top := (Pageheight - height) div 2;
                                    right := left + width;
                                    bottom := top + height;
                                end;
                            hlock(handle(CGrafPort(ThePort^).PortPixMap));
                            CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(ThePort^).PortPixMap)^^, osroiRect, PrintRect, SrcCopy, nil);
                            hunlock(handle(CGrafPort(ThePort^).PortPixMap))
                        end
                    else
                        CopyBits(BitMapHandle(osPort^.portPixMap)^^, thePort^.PortBits, osRoiRect, osroiRect, SrcCopy, nil);
                    hunlock(handle(osPort^.portPixMap));
                end;
    end;


    procedure PrintResults (PageHeight: integer; var PrintPort: TPPrPort);
        const
            LinesPerPage = 59;
            MaxLine = 100;
        var
            LineInc, hloc, vloc, i, LineCount, CharCount: integer;
            aLine: str255;
    begin
        CopyResultsToBuffer;
        TextOnClip := false;
        LineInc := PageHeight div LinesPerPage;
        hloc := 0;
        vloc := LineInc;
        LineCount := 0;
        CharCount := 0;
        TextFont(Monaco);
        TextSize(9);
        i := 1;
        repeat
            while TextBufP^[i] >= ' ' do begin
                    CharCount := CharCount + 1;
                    aLine[CharCount] := TextBufP^[i];
                    i := i + 1;
                end;
            aLine[0] := chr(CharCount);
            MoveTo(hloc, vloc);
            DrawString(aLine);
            CharCount := 0;
            if TextBufP^[i] = return then begin
                    vLoc := vLoc + LineInc;
                    hloc := 0;
                    LineCount := LineCount + 1;
                    if LineCount >= LinesPerPage then begin
                            LineCount := 0;
                            if i < TextBufSize then begin
                                    PrClosePage(PrintPort);
                                    PrintErrCheck;
                                    PrOpenPage(PrintPort, nil);
                                    vloc := LineInc
                                end;
                        end;
                end;
            i := i + 1;
        until i > TextBufSize;
    end;


    procedure Print (ShowDialog: boolean);
        var
            err, i, LinesToPrint: Integer;
            tPort: GrafPtr;
            PrintPort: TPPrPort;
            PrintStatusRec: TPrStatus;
            prect: rect;
            result, OptionKeyWasDown: boolean;
    begin
        OptionKeyWasDown := OptionKeyDown;
        ValuesMode := CountValues;
        DrawLabels;
        if WhatToPrint = PrintImage then
            SelectAll(false);
        if (WhatToPrint = PrintImage) or (WhatToPrint = PrintSelection) then begin
                if OpPending then
                    KillRoi;
                with info^.osroiRect do
                    LinesToPrint := bottom - top;
                Show2Values(0, LinesToPrint);
            end;
        GetPort(tPort);
        if PrintRecord = nil then begin
                PrintRecord := THPrint(NewHandle(SizeOF(TPrint)));
                PrintDefault(PrintRecord);
            end;
        PrOpen;
        if PrError = NoErr then begin
                result := PrValidate(PrintRecord);
                isLaserWriter := BSR(PrintRecord^^.prStl.wDev, 8) = 3;
                prect := PrintRecord^^.prInfo.rPage;
                if ShowDialog then
                    result := PrJobDialog(PrintRecord)
                else
                    result := true;
                SetCursor(watch^^);
                if result then
                    for i := 1 to PrintRecord^^.PrJob.icopies do begin
                            PrintPort := PrOpenDoc(PrintRecord, nil, nil);
                            PrintErrCheck;
                            Printing := true;
                            PrOpenPage(PrintPort, nil);
                            if PrError = NoErr then
                                case WhatToPrint of
                                    PrintImage, PrintSelection:
                                        PrintPicture(OptionKeyWasDown, prect.right, prect.bottom);
                                    PrintAreas, PrintLengths, PrintPoints:
                                        PrintResults(prect.Bottom, PrintPort);
                                    PrintPlot:
                                        DrawPlot;
                                    PrintHistogram:
                                        DrawHistogram;
                                end;
                            Printing := false;
                            PrClosePage(PrintPort);
                            PrintErrCheck;
                            PrCloseDoc(PrintPort);
                            PrintErrCheck;
                            if PrintRecord^^.prJob.bJDocLoop = bSpoolLoop then
                                PrPicFile(PrintRecord, nil, nil, nil, PrintStatusRec);
                        end;
            end;
        PrClose;
        SetPort(tPort);
        if WhatToPrint = PrintImage then
            KillRoi;
    end;


    procedure SetHalftone;
        const
            FrequencyID = 11;
            FirstAngleID = 3;
            LastAngleID = 5;
        var
            mylog: DialogPtr;
            item, i, ignore, SaveFrequency, SaveAngle, AngleID: integer;
            SaveFunction: boolean;
            str: str255;
    begin
        SaveFrequency := HalftoneFrequency;
        SaveAngle := HalftoneAngle;
        SaveFunction := HalftoneDotFunction;
        mylog := GetNewDialog(30, nil, pointer(-1));
        SetDNum(MyLog, FrequencyID, HalftoneFrequency);
        SelIText(MyLog, FrequencyID, 0, 32767);
        OutlineButton(MyLog, ok, 16);
        if HalftoneAngle = 45 then
            AngleID := FirstAngleID
        else if HalftoneAngle = 90 then
            AngleID := FirstAngleID + 1
        else if HalftoneAngle = 0 then
            AngleID := FirstAngleID + 2;
        SetDialogItem(mylog, AngleID, 1);
        if HalftoneDotFunction then
            SetDialogItem(mylog, 7, 1)
        else
            SetDialogItem(mylog, 8, 1);
        repeat
            ModalDialog(nil, item);
            if item = FrequencyID then
                HalftoneFrequency := GetDNum(MyLog, FrequencyID);
            if (item >= FirstAngleID) and (item <= LastAngleID) then begin
                    for i := FirstAngleID to LastAngleID do
                        SetDialogItem(mylog, i, 0);
                    SetDialogItem(mylog, item, 1);
                    AngleID := item;
                    case AngleID of
                        3:
                            HalftoneAngle := 45;
                        4:
                            HalftoneAngle := 90;
                        5:
                            HalftoneAngle := 0;
                    end;
                end;
            if (item >= 7) and (item <= 8) then begin
                    for i := 7 to 8 do
                        SetDialogItem(mylog, i, 0);
                    SetDialogItem(mylog, item, 1);
                    HalftoneDotFunction := item = 7;
                end;
        until (item = ok) or (item = cancel);
        DisposDialog(mylog);
        if item = cancel then begin
                HalftoneFrequency := SaveFrequency;
                HalftoneAngle := SaveAngle;
                HalftoneDotFunction := SaveFunction;
            end;
    end;

    procedure GetFileInfo (name: str255; vnum: integer; var DateCreated, LastModified: str255);
        var
            FileParmBlock: ParmBlkPtr;
            theErr: OSErr;
            DateVar, TimeVar: str255;
            Secs: LongInt;
    begin
        DateCreated := '';
        new(FIleParmBlock);
        if FileParmBlock <> nil then
            with FileParmBlock^ do begin
                    ioCompletion := nil;
                    ioNamePtr := @name;
                    ioVRefNum := vnum;
                    ioFVersNum := 0;
                    ioFDirIndex := 0;
                    theErr := PBGetFInfo(FileParmBlock, false);
                    if theErr = NoErr then begin
                            Secs := ioFlCrDat;
                            IUDateString(Secs, abbrevDate, DateVar);
                            IUTimeString(Secs, true, TimeVar);
                            DateCreated := concat(DateVar, '  ', TimeVar);
                            Secs := ioFlMDDat;
                            IUDateString(Secs, abbrevDate, DateVar);
                            IUTimeString(Secs, true, TimeVar);
                            LastModified := concat(DateVar, '  ', TimeVar);
                        end;
                    Dispose(FileParmBlock);
                end;
    end;


    procedure GetVolumnInfo (vnum: integer; var VolumnName: str255; var FreeSpace: LongInt);
        var
            theErr: OSErr;
            SPtr: StringPtr;
            VolParmBlock: ParmBlkPtr;
    begin
        VolumnName := '';
        new(SPtr);
        new(VolParmBlock);
        if (SPtr <> nil) and (VolParmBlock <> nil) then
            with VolParmBlock^ do begin
                    SPtr^ := '';
                    ioVRefNum := vnum;
                    ioNamePtr := SPtr;
                    ioCompletion := nil;
                    ioVolIndex := -1;
                    theErr := PBGetVInfo(VolParmBlock, false);
                    VolumnName := ioNamePtr^;
                    FreeSpace := ioVAlBlkSiz * ioVFrBlk;
                    dispose(SPtr);
                    dispose(VolParmBlock);
                end;
    end;


    procedure GetInfo;
        const
            InfoWindowWidth = 260;
            InfoWindowHeight = 300;
        var
            name, str, DateCreated, LastModified, VolumnName: str255;
            hloc, vloc: integer;
            tPort: GrafPtr;
            SaveRoiShowing: boolean;
            FreeSpace: LongInt;
            SaveForeIndex, SaveBackIndex: integer;

        procedure NewLine;
        begin
            vloc := vloc + 13;
            MoveTo(hloc, vloc);
        end;

        procedure NewParagraph;
        begin
            vloc := vloc + 18;
            MoveTo(hloc, vloc);
        end;

    begin
        name := concat('Info About ', info^.title);
        SaveRoiShowing := info^.RoiShowing;
        SaveForeIndex := ForegroundColor;
        SaveBackIndex := BackgroundColor;
        SetForegroundColor(BlackC);
        SetBackgroundColor(WhiteC);
        if NewPicWindow(name, InfoWindowWidth, InfoWindowHeight) then
            with SaveInfo^ do begin
                    hloc := 15;
                    vloc := 10;
                    GetPort(tPort);
                    SetPort(GrafPtr(info^.osPort));
                    TextFont(ApplFont);
                    TextSize(9);
                    NewLine;
                    DrawBString('Name: ');
                    DrawString(title);
                    NewParagraph;
                    DrawBString('Width: ');
                    DrawLong(PixelsPerLine);
                    NewLine;
                    DrawBString('Height: ');
                    DrawLong(nlines);
                    NewLine;
                    DrawBString('Size: ');
                    DrawLong(PicSize div 1024);
                    DrawString('K');
                    NewParagraph;
                    GetFileInfo(title, vref, DateCreated, LastModified); {DateCreated:='';}
                    if DateCreated <> '' then begin
                            DrawBString('Creation Date: ');
                            DrawString(DateCreated);
                            NewLine;
                            DrawBString('Last Modified: ');
                            DrawString(LastModified);
                            NewLine;
                        end;
                    GetVolumnInfo(vref, VolumnName, FreeSpace);
                    if VolumnName <> '' then begin
                            DrawBString('Volume: ');
                            DrawString(VolumnName);
                            DrawString(' (');
                            DrawLong(FreeSpace div 1024);
                            DrawString('K free)');
                            NewParagraph;
                        end;
                    DrawBString('Type: ');
                    case PictureType of
                        pdp11:
                            str := 'PDP-11';
                        NewPicture:
                            str := 'New';
                        normal:
                            str := 'Normal';
                        PictFile:
                            str := 'PICT';
                        TiffFile:
                            str := 'TIFF';
                        InvertedTIFF:
                            str := 'TIFF';
                        Leftover:
                            str := 'Left Over';
                        imported:
                            str := 'Imported';
                        camera:
                            str := 'Camera(QuickCapture)';
                        BlankField:
                            str := 'Blank Field';
                        ScionType:
                            str := 'Camera(Scion)';
                        otherwise
                            ;
                    end;
                    if BinaryPic then
                        str := concat(str, ' (Binary)');
                    DrawString(str);
                    NewLine;
                    DrawBString('Lookup Table: ');
                    case LutMode of
                        ColorPalette:
                            str := 'Pseudocolor';
                        AppleDefault:
                            str := 'System';
                        Spectrum:
                            str := 'Spectrum';
                        GrayScale:
                            str := 'Grayscale';
                        Custom:
                            str := 'Custom';
                        CustomGrayscale:
                            str := 'Custom Grayscale';
                        otherwise
                    end;
                    DrawString(str);
                    NewLine;
                    DrawBString('Magnification: ');
                    if ScaleToFitWindow then begin
                            DrawReal(magnification, 1, 2);
                            DrawString(' (Scale to Window Mode)')
                        end
                    else begin
                            DrawReal(magnification, 1, 0);
                            DrawString(':1')
                        end;
                    NewLine;
                    DrawBString('Scale: ');
                    if scale <> 0.0 then begin
                            DrawReal(scale, 1, 3);
                            DrawString(' Pixels Per ');
                            DrawString(units)
                        end
                    else
                        DrawString('None');
                    if calibrated then begin
                            NewLine;
                            DrawBString('Unit of Measure:');
                            if UnitOfMEasure = '' then
                                DrawString('None')
                            else
                                DrawString(UnitOfMeasure)
                        end;
                    NewParagraph;
                    DrawBString('Free RAM: ');
                    DrawLong(FreeMem div 1024);
                    DrawString('K');
                    NewLine;
                    DrawBString('Largest Free Block: ');
                    DrawLong(MaxBlock div 1024);
                    DrawString('K');
                    NewParagraph;
                    if RoiType <> NoRoi then begin
                            DrawBString('Selection Type: ');
                            case RoiType of
                                RgnRoi:
                                    DrawString('Freehand or Polygon');
                                RectRoi:
                                    DrawString('Rectangle');
                                OvalRoi:
                                    DrawString('Oval');
                                RoundRectRoi:
                                    DrawString('Rounded Rectangle');
                            end;
                            NewLine;
                            with osroirect do begin
                                    DrawBString('    Location: ');
                                    DrawLong(left);
                                    DrawString(', ');
                                    DrawLong(PicRect.bottom - top - 1);
                                    NewLine;
                                    DrawBString('    Width: ');
                                    DrawLong(right - left);
                                    NewLine;
                                    DrawBString('    Height: ');
                                    DrawLong(bottom - top);
                                end
                        end
                    else
                        DrawBString('No Selection');
                    SetPort(tPort);
                end;
        SetForegroundColor(SaveForeIndex);
        SetBackgroundColor(SaveBackIndex);
    end;

end.